home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group92c.txt / 000011_icon-group-sender _Mon Oct 5 03:07:06 1992.msg < prev    next >
Internet Message Format  |  1993-01-04  |  22KB
  1. Received: by cheltenham.cs.arizona.edu; Tue, 6 Oct 1992 10:22:24 MST
  2. Date: 5 Oct 92 03:07:06 GMT
  3. From: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!sdd.hp.com!ux1.cso.uiuc.edu!uchinews!ellis!goer@ucbvax.Berkeley.EDU  (Richard L. Goerwitz)
  4. Organization: University of Chicago Computing Organizations
  5. Subject: offending program
  6. Message-Id: <1992Oct5.030706.477@midway.uchicago.edu>
  7. Sender: icon-group-request@cs.arizona.edu
  8. To: icon-group@cs.arizona.edu
  9. Status: R
  10. Errors-To: icon-group-errors@cs.arizona.edu
  11.  
  12. Abstract discussions aren't too useful, always.  Here's an example
  13. of a simple program created by the parser generator whose tables I
  14. want to be able to store.  The following example initializes itself
  15. by decoding a string encoded by "encode" (see codeobj.icn in the
  16. IPL).
  17.  
  18. Should work with version 8 installations.  For the compiler, uncom-
  19. ment the invocable declaration.  I have compiled the program success-
  20. fully, but haven't gotten the executable to run.
  21.  
  22. Compile, execute, and type something like "5 + 5," then hit a CR.
  23.  
  24. -Richard
  25.  
  26.  
  27. -------------------------------  cut here  --------------------------------
  28.  
  29. #invocable "ACT", "symbol", "TOK"
  30.  
  31. global ID_tbl
  32. procedure main()
  33. iparse(&input)
  34. end
  35. procedure _0001(arg1)
  36. return
  37. end
  38. procedure _0003(arg1,arg2)
  39. return
  40. end
  41. procedure _0005(arg1)
  42. return
  43. end
  44. procedure _0007(arg1,arg2)
  45. line_number +:= 1
  46. return write(arg1)
  47. end
  48. procedure _0009(arg1)
  49. if not (return \ID_tbl[arg1])
  50. then write(&errout, "uninitialized variable, line ", line_number)
  51. fail
  52. end
  53. procedure _0011(arg1,arg2,arg3)
  54. initial ID_tbl := table()
  55. ID_tbl[arg1] := arg3
  56. return arg3
  57. end
  58. procedure _0013(arg1,arg2,arg3)
  59. return arg1 + arg3
  60. end
  61. procedure _0015(arg1,arg2,arg3)
  62. return arg1 - arg3
  63. end
  64. procedure _0017(arg1,arg2,arg3)
  65. return arg1 * arg3
  66. end
  67. procedure _0019(arg1,arg2,arg3)
  68. return arg1 / arg3
  69. end
  70. procedure _0021(arg1,arg2,arg3)
  71. return arg1 % arg3
  72. end
  73. procedure _0023(arg1,arg2,arg3)
  74. return arg1 ^ arg3
  75. end
  76. procedure _0025(arg1,arg2,arg3)
  77. return arg2
  78. end
  79. procedure _0027(arg1)
  80. if find(".", arg1)
  81. then return real(arg1)
  82. else return integer(arg1)
  83. end
  84.  
  85. # I use ximage for debugging; remove it if you don't need it.
  86. link codeobj, ximage
  87.  
  88. record ACT(str, state, by_rule, sym, size)
  89. record symbol(str, terminal)
  90. record TOK(sym, str)
  91.  
  92. global line_number, errors
  93.  
  94. #
  95. # iparse:  file     -> ?
  96. #          stream   -> ?
  97. #
  98. #     Where stream is an open file, and ? represents the user-defined
  99. #     result of a completed parse of file, from the current location
  100. #     up to the point where the parser executes an "accept" action.
  101. #
  102. #     The second to fifth arguments are used on recursive calls from
  103. #     the error handler, iparse_error.  Ignore them, unless you are
  104. #     sure of what you are doing!
  105. #
  106. procedure iparse(stream, state_stack, value_stack, next_token, err_state)
  107.  
  108.     local start_symbol, token, act, arglist
  109.     static alst, glst
  110.     #global line_number, errors
  111.     initial {
  112.     alst := decode("l7341Lla122T0n1s(lb21R3sACT5sshift1i80n0n0n2sCR_
  113.         lc21R3sACT5sshift1i50n0n0n2sIDld21R3sACT5sshift1i70n0n0n3sNU_
  114.         Mle21R3sACT5sshift1i90n0n0nlf31T0n1s$lg21R3sACT6saccept0n0n0_
  115.         n0nlh38T0n1s$li28R3sACT6sreduce0n5s_00011sS1i1lj163T0n1s$lk3_
  116.         3R3sACT6sreduce0n5s_00036sstream1i11s(ll21R3sACT5sshift1i80n_
  117.         0n0n2sCRlm21R3sACT5sshift1i50n0n0n2sIDln21R3sACT5sshift1i70n_
  118.         0n0n3sNUMlo21R3sACT5sshift1i90n0n0nlp201T0n1s$lq31R3sACT6sre_
  119.         duce0n5s_00054scalc1i11s(lr31R3sACT6sreduce0n5s_00054scalc1i_
  120.         12sCRls31R3sACT6sreduce0n5s_00054scalc1i12sIDlt31R3sACT6sred_
  121.         uce0n5s_00054scalc1i13sNUMlu31R3sACT6sreduce0n5s_00054scalc1_
  122.         i1lv216T0n1s%lw22R3sACT5sshift2i160n0n0n1s*lx22R3sACT5sshift_
  123.         2i140n0n0n1s+ly22R3sACT5sshift2i120n0n0n1s-lz22R3sACT5sshift_
  124.         2i130n0n0n1s/laa22R3sACT5sshift2i150n0n0n2sCRlab22R3sACT5ssh_
  125.         ift2i110n0n0n1s^lac22R3sACT5sshift2i170n0n0nlad314T0n1s%lae3_
  126.         1R3sACT6sreduce0n5s_00094sexpr1i11s*laf31R3sACT6sreduce0n5s__
  127.         00094sexpr1i11s+lag31R3sACT6sreduce0n5s_00094sexpr1i11s-lah3_
  128.         1R3sACT6sreduce0n5s_00094sexpr1i11s/lai31R3sACT6sreduce0n5s__
  129.         00094sexpr1i11s=laj22R3sACT5sshift2i180n0n0n2sCRlak31R3sACT6_
  130.         sreduce0n5s_00094sexpr1i11s^lal31R3sACT6sreduce0n5s_00094sex_
  131.         pr1i1lam98T0n1s(lan22R3sACT5sshift2i210n0n0n2sIDlao22R3sACT5_
  132.         sshift2i200n0n0n3sNUMlap22R3sACT5sshift2i220n0n0nlaq283T0n1s_
  133.         %lar31R3sACT6sreduce0n5s_00274sexpr1i11s*las31R3sACT6sreduce_
  134.         0n5s_00274sexpr1i11s+lat31R3sACT6sreduce0n5s_00274sexpr1i11s_
  135.         -lau31R3sACT6sreduce0n5s_00274sexpr1i11s/lav31R3sACT6sreduce_
  136.         0n5s_00274sexpr1i12sCRlaw31R3sACT6sreduce0n5s_00274sexpr1i11_
  137.         s^lax31R3sACT6sreduce0n5s_00274sexpr1i1lay44T0n1s$laz33R3sAC_
  138.         T6sreduce0n5s_00036sstream1i2lba206T0n1s$lbb31R3sACT6sreduce_
  139.         0n5s_00074scalc1i21s(lbc31R3sACT6sreduce0n5s_00074scalc1i22s_
  140.         CRlbd31R3sACT6sreduce0n5s_00074scalc1i22sIDlbe31R3sACT6sredu_
  141.         ce0n5s_00074scalc1i23sNUMlbf31R3sACT6sreduce0n5s_00074scalc1_
  142.         i2lbg95T0n1s(lbh21R3sACT5sshift1i80n0n0n2sIDlbi21R3sACT5sshi_
  143.         ft1i70n0n0n3sNUMlbj21R3sACT5sshift1i90n0n0n3llbg3llbg3llbg3l_
  144.         lbg3llbg3llbglbk219T0n1s%lbl22R3sACT5sshift2i350n0n0n1s)lbm2_
  145.         2R3sACT5sshift2i300n0n0n1s*lbn22R3sACT5sshift2i330n0n0n1s+lb_
  146.         o22R3sACT5sshift2i310n0n0n1s-lbp22R3sACT5sshift2i320n0n0n1s/_
  147.         lbq22R3sACT5sshift2i340n0n0n1s^lbr22R3sACT5sshift2i360n0n0nl_
  148.         bs313T0n1s%lbt31R3sACT6sreduce0n5s_00094sexpr1i11s)lbu31R3sA_
  149.         CT6sreduce0n5s_00094sexpr1i11s*lbv31R3sACT6sreduce0n5s_00094_
  150.         sexpr1i11s+lbw31R3sACT6sreduce0n5s_00094sexpr1i11s-lbx31R3sA_
  151.         CT6sreduce0n5s_00094sexpr1i11s/lby31R3sACT6sreduce0n5s_00094_
  152.         sexpr1i11s=lbz22R3sACT5sshift2i370n0n0n1s^lca31R3sACT6sreduc_
  153.         e0n5s_00094sexpr1i13llamlcb282T0n1s%lcc31R3sACT6sreduce0n5s__
  154.         00274sexpr1i11s)lcd31R3sACT6sreduce0n5s_00274sexpr1i11s*lce3_
  155.         1R3sACT6sreduce0n5s_00274sexpr1i11s+lcf31R3sACT6sreduce0n5s__
  156.         00274sexpr1i11s-lcg31R3sACT6sreduce0n5s_00274sexpr1i11s/lch3_
  157.         1R3sACT6sreduce0n5s_00274sexpr1i11s^lci31R3sACT6sreduce0n5s__
  158.         00274sexpr1i1lcj247T0n1s%lck22R3sACT5sshift2i160n0n0n1s*lcl2_
  159.         2R3sACT5sshift2i140n0n0n1s+lcm31R3sACT6sreduce0n5s_00134sexp_
  160.         r1i31s-lcn31R3sACT6sreduce0n5s_00134sexpr1i31s/lco22R3sACT5s_
  161.         shift2i150n0n0n2sCRlcp31R3sACT6sreduce0n5s_00134sexpr1i31s^l_
  162.         cq22R3sACT5sshift2i170n0n0nlcr247T0n1s%lcs22R3sACT5sshift2i1_
  163.         60n0n0n1s*lct22R3sACT5sshift2i140n0n0n1s+lcu31R3sACT6sreduce_
  164.         0n5s_00154sexpr1i31s-lcv31R3sACT6sreduce0n5s_00154sexpr1i31s_
  165.         /lcw22R3sACT5sshift2i150n0n0n2sCRlcx31R3sACT6sreduce0n5s_001_
  166.         54sexpr1i31s^lcy22R3sACT5sshift2i170n0n0nlcz274T0n1s%lda31R3_
  167.         sACT6sreduce0n5s_00174sexpr1i31s*ldb31R3sACT6sreduce0n5s_001_
  168.         74sexpr1i31s+ldc31R3sACT6sreduce0n5s_00174sexpr1i31s-ldd31R3_
  169.         sACT6sreduce0n5s_00174sexpr1i31s/lde31R3sACT6sreduce0n5s_001_
  170.         74sexpr1i32sCRldf31R3sACT6sreduce0n5s_00174sexpr1i31s^ldg22R_
  171.         3sACT5sshift2i170n0n0nldh274T0n1s%ldi31R3sACT6sreduce0n5s_00_
  172.         194sexpr1i31s*ldj31R3sACT6sreduce0n5s_00194sexpr1i31s+ldk31R_
  173.         3sACT6sreduce0n5s_00194sexpr1i31s-ldl31R3sACT6sreduce0n5s_00_
  174.         194sexpr1i31s/ldm31R3sACT6sreduce0n5s_00194sexpr1i32sCRldn31_
  175.         R3sACT6sreduce0n5s_00194sexpr1i31s^ldo22R3sACT5sshift2i170n0_
  176.         n0nldp274T0n1s%ldq31R3sACT6sreduce0n5s_00214sexpr1i31s*ldr31_
  177.         R3sACT6sreduce0n5s_00214sexpr1i31s+lds31R3sACT6sreduce0n5s_0_
  178.         0214sexpr1i31s-ldt31R3sACT6sreduce0n5s_00214sexpr1i31s/ldu31_
  179.         R3sACT6sreduce0n5s_00214sexpr1i32sCRldv31R3sACT6sreduce0n5s__
  180.         00214sexpr1i31s^ldw22R3sACT5sshift2i170n0n0nldx283T0n1s%ldy3_
  181.         1R3sACT6sreduce0n5s_00234sexpr1i31s*ldz31R3sACT6sreduce0n5s__
  182.         00234sexpr1i31s+lea31R3sACT6sreduce0n5s_00234sexpr1i31s-leb3_
  183.         1R3sACT6sreduce0n5s_00234sexpr1i31s/lec31R3sACT6sreduce0n5s__
  184.         00234sexpr1i32sCRled31R3sACT6sreduce0n5s_00234sexpr1i31s^lee_
  185.         31R3sACT6sreduce0n5s_00234sexpr1i3lef229T0n1s%leg22R3sACT5ss_
  186.         hift2i160n0n0n1s*leh22R3sACT5sshift2i140n0n0n1s+lei22R3sACT5_
  187.         sshift2i120n0n0n1s-lej22R3sACT5sshift2i130n0n0n1s/lek22R3sAC_
  188.         T5sshift2i150n0n0n2sCRlel31R3sACT6sreduce0n5s_00114sexpr1i31_
  189.         s^lem22R3sACT5sshift2i170n0n0nlen283T0n1s%leo31R3sACT6sreduc_
  190.         e0n5s_00254sexpr1i31s*lep31R3sACT6sreduce0n5s_00254sexpr1i31_
  191.         s+leq31R3sACT6sreduce0n5s_00254sexpr1i31s-ler31R3sACT6sreduc_
  192.         e0n5s_00254sexpr1i31s/les31R3sACT6sreduce0n5s_00254sexpr1i32_
  193.         sCRlet31R3sACT6sreduce0n5s_00254sexpr1i31s^leu31R3sACT6sredu_
  194.         ce0n5s_00254sexpr1i33llam3llam3llam3llam3llam3llam3llamlev21_
  195.         9T0n1s%lew22R3sACT5sshift2i350n0n0n1s)lex22R3sACT5sshift2i46_
  196.         0n0n0n1s*ley22R3sACT5sshift2i330n0n0n1s+lez22R3sACT5sshift2i_
  197.         310n0n0n1s-lfa22R3sACT5sshift2i320n0n0n1s/lfb22R3sACT5sshift_
  198.         2i340n0n0n1s^lfc22R3sACT5sshift2i360n0n0nlfd246T0n1s%lfe22R3_
  199.         sACT5sshift2i350n0n0n1s)lff31R3sACT6sreduce0n5s_00134sexpr1i_
  200.         31s*lfg22R3sACT5sshift2i330n0n0n1s+lfh31R3sACT6sreduce0n5s_0_
  201.         0134sexpr1i31s-lfi31R3sACT6sreduce0n5s_00134sexpr1i31s/lfj22_
  202.         R3sACT5sshift2i340n0n0n1s^lfk22R3sACT5sshift2i360n0n0nlfl246_
  203.         T0n1s%lfm22R3sACT5sshift2i350n0n0n1s)lfn31R3sACT6sreduce0n5s_
  204.         _00154sexpr1i31s*lfo22R3sACT5sshift2i330n0n0n1s+lfp31R3sACT6_
  205.         sreduce0n5s_00154sexpr1i31s-lfq31R3sACT6sreduce0n5s_00154sex_
  206.         pr1i31s/lfr22R3sACT5sshift2i340n0n0n1s^lfs22R3sACT5sshift2i3_
  207.         60n0n0nlft273T0n1s%lfu31R3sACT6sreduce0n5s_00174sexpr1i31s)l_
  208.         fv31R3sACT6sreduce0n5s_00174sexpr1i31s*lfw31R3sACT6sreduce0n_
  209.         5s_00174sexpr1i31s+lfx31R3sACT6sreduce0n5s_00174sexpr1i31s-l_
  210.         fy31R3sACT6sreduce0n5s_00174sexpr1i31s/lfz31R3sACT6sreduce0n_
  211.         5s_00174sexpr1i31s^lga22R3sACT5sshift2i360n0n0nlgb273T0n1s%l_
  212.         gc31R3sACT6sreduce0n5s_00194sexpr1i31s)lgd31R3sACT6sreduce0n_
  213.         5s_00194sexpr1i31s*lge31R3sACT6sreduce0n5s_00194sexpr1i31s+l_
  214.         gf31R3sACT6sreduce0n5s_00194sexpr1i31s-lgg31R3sACT6sreduce0n_
  215.         5s_00194sexpr1i31s/lgh31R3sACT6sreduce0n5s_00194sexpr1i31s^l_
  216.         gi22R3sACT5sshift2i360n0n0nlgj273T0n1s%lgk31R3sACT6sreduce0n_
  217.         5s_00214sexpr1i31s)lgl31R3sACT6sreduce0n5s_00214sexpr1i31s*l_
  218.         gm31R3sACT6sreduce0n5s_00214sexpr1i31s+lgn31R3sACT6sreduce0n_
  219.         5s_00214sexpr1i31s-lgo31R3sACT6sreduce0n5s_00214sexpr1i31s/l_
  220.         gp31R3sACT6sreduce0n5s_00214sexpr1i31s^lgq22R3sACT5sshift2i3_
  221.         60n0n0nlgr282T0n1s%lgs31R3sACT6sreduce0n5s_00234sexpr1i31s)l_
  222.         gt31R3sACT6sreduce0n5s_00234sexpr1i31s*lgu31R3sACT6sreduce0n_
  223.         5s_00234sexpr1i31s+lgv31R3sACT6sreduce0n5s_00234sexpr1i31s-l_
  224.         gw31R3sACT6sreduce0n5s_00234sexpr1i31s/lgx31R3sACT6sreduce0n_
  225.         5s_00234sexpr1i31s^lgy31R3sACT6sreduce0n5s_00234sexpr1i3lgz2_
  226.         28T0n1s%lha22R3sACT5sshift2i350n0n0n1s)lhb31R3sACT6sreduce0n_
  227.         5s_00114sexpr1i31s*lhc22R3sACT5sshift2i330n0n0n1s+lhd22R3sAC_
  228.         T5sshift2i310n0n0n1s-lhe22R3sACT5sshift2i320n0n0n1s/lhf22R3s_
  229.         ACT5sshift2i340n0n0n1s^lhg22R3sACT5sshift2i360n0n0nlhh282T0n_
  230.         1s%lhi31R3sACT6sreduce0n5s_00254sexpr1i31s)lhj31R3sACT6sredu_
  231.         ce0n5s_00254sexpr1i31s*lhk31R3sACT6sreduce0n5s_00254sexpr1i3_
  232.         1s+lhl31R3sACT6sreduce0n5s_00254sexpr1i31s-lhm31R3sACT6sredu_
  233.         ce0n5s_00254sexpr1i31s/lhn31R3sACT6sreduce0n5s_00254sexpr1i3_
  234.         1s^lho31R3sACT6sreduce0n5s_00254sexpr1i3")
  235.     glst := decode("lhp550Llhq37T0n1sS1i24scalc1i44sexpr1i66sstream_
  236.         1i3lhr2T0nlhs2T0nlht32T0n4scalc1i44sexpr1i66sstream2i10lhu2T_
  237.         0n0nlhv2T0nlhw12T0n4sexpr2i19lhx2T0nlhy2T0nlhz2T0nlia12T0n4s_
  238.         expr2i23lib12T0n4sexpr2i24lic12T0n4sexpr2i25lid12T0n4sexpr2i_
  239.         26lie12T0n4sexpr2i27lif12T0n4sexpr2i28lig12T0n4sexpr2i290nli_
  240.         h2T0nlii12T0n4sexpr2i38lij2T0nlik2T0nlil2T0nlim2T0nlin2T0nli_
  241.         o2T0nlip2T0nliq2T0nlir2T0nlis12T0n4sexpr2i39lit12T0n4sexpr2i_
  242.         40liu12T0n4sexpr2i41liv12T0n4sexpr2i42liw12T0n4sexpr2i43lix1_
  243.         2T0n4sexpr2i44liy12T0n4sexpr2i450nliz2T0nlja2T0nljb2T0nljc2T_
  244.         0nljd2T0nlje2T0nljf2T0nljg2T0n")
  245.     #
  246.     # Uncomment the following if you want a look at the state and goto
  247.     # tables.  If you aren't planning on looking at them, find the
  248.     # procedure definition for dump_lists below, and delete it.  Why
  249.     # keep it around if it's not being used?
  250.     #
  251.     # dump_lists(&errout, alst, glst)
  252.     }
  253.     #
  254.     # New, not recursive, invocation; reset stacks, line number and
  255.     # error count.
  256.     #
  257.     start_symbol := "S"
  258.     /err_state   := 1
  259.     /state_stack := [1] & line_number := 0 & errors := 0
  260.     /value_stack := []
  261.     /next_token  := create iparse_tokens(stream)
  262.  
  263.     while token := @next_token do {
  264.     repeat {
  265.         act := \alst[state_stack[1]][token.sym] | {
  266.         #
  267.         # You can replace this error handler with whatever you
  268.         # like, and have it do whatever you like.
  269.         #
  270.             # (iparse_error increments global errors variable)
  271.         return iparse_error(alst, state_stack, value_stack,
  272.                     token, next_token, err_state)
  273.         }
  274.         err_state := 0
  275.         case act.str of {
  276.             "shift"   :  {
  277.             # push the next state onto the state stack
  278.                 push(state_stack, act.state)
  279.             # push the current token's literal value onto the
  280.             # value stack
  281.             push(value_stack, token.str)
  282.             # break out of enclosing repeat loop
  283.             break
  284.             }
  285.             "reduce"  :  {
  286.                 arglist := []
  287.             #
  288.             # Pop as many elements off of the token stack as
  289.             # there are symbols in the right-hand side of the
  290.             # rule.  Push these elements onto an argument list.
  291.             #
  292.             every 1 to act.size do {
  293.                 pop(state_stack)
  294.                 push(arglist, pop(value_stack))
  295.             }
  296.             #
  297.             # Check to goto list to see what state we should
  298.             # be in, and push that state onto the state stack.
  299.             #
  300.             push(state_stack,
  301.              glst[state_stack[1]][act.sym])
  302.             #
  303.             # Call the code associated with the current
  304.             # reduction, and push the result onto the stack.
  305.             # For more results, push a coexpression instead.
  306.             #
  307.             push(value_stack, (proc(act.by_rule)!arglist)) | {
  308.             # On failure, return the stacks to the state
  309.             # they were in before the last reduction.
  310.             pop(state_stack)
  311.             return iparse_error(alst, state_stack, value_stack,
  312.                         token, next_token, err_state + 1)
  313.             }
  314.         }
  315.         "accept"  :  {
  316.             #
  317.             # We're done.  Return the last result.
  318.             #
  319.             return value_stack[1]
  320.             }
  321.         }
  322.     }
  323.     }
  324.     write(&errout, "iparse:  unexpected end of input")
  325.     fail
  326.  
  327. end
  328.  
  329. #
  330. # iparse_tokens:  file  -> TOK records (a generator)
  331. #                stream -> tokens
  332. #
  333. #     Where file is an open input stream, and tokens are TOK
  334. #     records holding both the token type and actual token text.
  335. #
  336. #     TOK records contain two parts, a preterminal symbol (the first
  337. #     "sym" field), and the actual text of the token ("str").  The
  338. #     parser above only pays attention to the sym field, although the
  339. #     user might well want to use the actual text.
  340. #
  341. procedure iparse_tokens(stream)
  342.  
  343.     local token, c, whitespace, operators
  344.     #global line_number
  345.     whitespace := '\r\t \n'
  346.     operators  := '+-*/^()='
  347.  
  348.     token := ""
  349.     every c := !(!&input || "\n") do {
  350.     if not any(whitespace ++ operators, c) then {
  351.         token ||:= c
  352.     } else {
  353.         if integer(token)
  354.         then suspend TOK("NUM", "" ~== token)
  355.         else suspend TOK("ID", "" ~== token)
  356.         if any(operators, c) then
  357.         suspend TOK(c)
  358.         else {
  359.         if c == "\n" then {
  360.             line_number +:= 1
  361.             suspend TOK("CR"|"CR")
  362.         }
  363.         }
  364.         token := ""
  365.     }
  366.     }
  367.     if integer(token)
  368.     then suspend TOK("NUM", "" ~== token)
  369.     else suspend TOK("ID",  "" ~== token)
  370.     suspend TOK("CR"|"$")
  371.  
  372. end
  373.  
  374. #
  375. # iparse_error:  list x list x list x list x TOK x coexpression x integer -> ?
  376. #               (alst, state_stack, value_stack, token_stack, token,
  377. #                                  next_token, err_state) -> ?
  378. #
  379. #     Where alst is the action list, where state_stack is the state
  380. #     stack used by iparse, where token stack is the token stack used
  381. #     by iparse, where token is the current lookahead TOK record,
  382. #     where next_token is the coexpression from which we get our
  383. #     tokens, and where err_state indicates how many recursive calls
  384. #     we've made to the parser via the error handler without a
  385. #     recovery.
  386. #
  387. #     Recursively calls iparse, attempting to restart the parser after
  388. #     an error.  Increments global "errors" variable (a count of the
  389. #     number of errors encountered, minus cascading series of errors).
  390. #
  391. procedure iparse_error(alst, state_stack, value_stack,
  392.                token, next_token, err_state)
  393.     local sym
  394.     static tlst
  395.     #global line_number, errors
  396.     initial {
  397.     tlst := decode("lgv35S1s+1s(1s%1s-1s=1s*1s/1s$1s)1s^3sNUM")
  398.     }
  399.  
  400.     #
  401.     # Check to see how many attempts we have made at a resync.  If
  402.     # this is a new error series, increment the global "errors" count.
  403.     #
  404.     if (err_state +:= 1) > 3 then
  405.     stop("iparse_error:  unable to resync after error; aborting")
  406.     else if err_state = 1 then
  407.     errors +:= 1  # GLOBAL
  408.  
  409.     #
  410.     # Check to see if the grammar even has this pre-terminal.
  411.     #
  412.     if not member(tlst, token.sym)
  413.     then write(&errout, "iparse_error:  unknown token, ", token.sym,
  414.     ", in line ", line_number)
  415.     # Only note the first in a series of cascading errors.
  416.     else if err_state = 1 then {
  417.     write(&errout, "iparse_error:  syntax error in line ",
  418.         line_number, "; resynchronizing parser")
  419.     }
  420.  
  421.     #
  422.     # Now, try to shift in the next input token to see if we can
  423.     # resync the parser.  Stream argument is null because next_token
  424.     # has already been created.
  425.     #
  426.     return iparse(&null, state_stack, value_stack, token_stack,
  427.           next_token, err_state)
  428.  
  429. end
  430.  
  431. #
  432. # dump_lists:  file x list x list -> (null)
  433. #              (f, gl, al)        -> (null)
  434. #
  435. #     Where f is an open file, gl is the goto list, and al is the
  436. #     action list.  Writes to file f a human-readable dump of the goto
  437. #     and action list.
  438. #
  439. procedure dump_lists(f, al, gl)
  440.  
  441.     local TAB, look_list, red_list, i, sym, act
  442.  
  443.     TAB := "\t"
  444.     look_list := list()
  445.     red_list := list()
  446.  
  447.     every i := 1 to *al do {
  448.     every INSERT(look_list, key(\al[i]))
  449.     if /al[i] then
  450.         write(&errout, "dump_lists:  warning!  state ", i, " is null")
  451.     }
  452.  
  453.     writes(f,TAB)
  454.     every i := 1 to *look_list do
  455.     writes(f,look_list[i], TAB)
  456.     write(f)
  457.     every i := 1 to *al do {
  458.     writes(f,i, TAB)
  459.     act := ""
  460.     every sym := !look_list do {
  461.         if \al[i][sym] then {
  462.         writes(f,al[i][sym].str[1:3], al[i][sym].state)
  463.         if al[i][sym].str == "reduce" then {
  464.             INSERT(red_list, al[i][sym].sym)
  465.             writes(f,al[i][sym].sym)
  466.         }
  467.         }
  468.         writes(f,TAB)
  469.     }
  470.     write(f)
  471.     }
  472.     write(f)
  473.  
  474.     writes(f,TAB)
  475.     every i := 1 to *red_list do
  476.     writes(f,red_list[i], TAB)
  477.     write(f)
  478.     every i := 1 to *gl do {
  479.     writes(f,i, TAB)
  480.     act := ""
  481.     every sym := !red_list do {
  482.         if \(\gl[i])[sym] then
  483.         writes(f,gl[i][sym])
  484.         writes(f,TAB)
  485.     }
  486.     write(f)
  487.     }
  488.  
  489. end
  490.  
  491. #
  492. # INSERT:  set or list x record -> set or list
  493. #        (sset, rec)          -> sset
  494. #
  495. #     Where sset is a homogenous set or list of records, rec is a
  496. #     record, and the return value is sset, with rec added, iff an
  497. #     equivalent record was not there already.  Otherwise, sset is
  498. #     returned unchanged. INSERT(), _unlike insert(), FAILS IF REC
  499. #     IS ALREADY PRESENT IN SSET.
  500. #
  501. #     This procedure is used by dump_lists() above.  If you delete
  502. #     dump_lists(), delete this as well, as also Equiv() below.
  503. #
  504. procedure INSERT(sset, rec)
  505.  
  506.     local addto
  507.     #
  508.     # Decide how to add members to sset, depending on its type.
  509.     #
  510.     addto := {
  511.     case type(sset) of {
  512.         "set"   : insert
  513.         "list"  : put
  514.         default : stop("INSERT:  wrong type argument (",type(sset),")")
  515.     }
  516.     }
  517.  
  518.     # Rudumentary error check to be sure the object to be inserted
  519.     # into sset is of the same time as the objects already there.
  520.     #
  521.     if *sset > 0 then
  522.     type(rec) == type(sset[1]) |
  523.         stop("INSERT:  unexpected type difference")
  524.  
  525.     #
  526.     # If a rec-like item isn't in sset, add it to sset.
  527.     #
  528.     if Equiv(!sset, rec) then fail
  529.     else return addto(sset, rec)
  530.  
  531. end
  532.     
  533.  
  534. #
  535. # Equiv: struct x struct -> struct
  536. #        (x1, x2)        -> x2
  537. #
  538. #     Where x1 and x2 are arbitrary structures.  Returns x2 if x1 and
  539. #     x2 are structurally equivalent (even if not identical).  Taken
  540. #     from the IPL file "structs.icn."
  541. #
  542. #     Equiv() is used by dump_lists() above.  If you delete
  543. #     dump_lists, delete this as well.
  544. #
  545. procedure Equiv(x1, x2, done)
  546.  
  547.    local code, i
  548.  
  549.    if x1 === x2 then return x2        # Covers everything but structures.
  550.    if type(x1) ~== type(x2) then fail    # Must be same type.
  551.    if type(x1) == ("procedure" | "file")# Leave only those with sizes (null
  552.       then fail                # taken care of by first two tests).
  553.    if *x1 ~= *x2 then fail
  554.  
  555.    /done := table()
  556.    (/done[x1] := set()) |        # Make set of equivalences if new.
  557.       (if member(done[x1],x2) then return x2)
  558.    # Records complicate things.
  559.    image(x1) ? (code := (="record" | type(x1)))
  560.    
  561.    case code of {
  562.        "list" | "record" :
  563.        every i := 1 to *x1 do
  564.            if not Equiv(x1[i],x2[i],done) then fail
  565.        "table" : if not Equiv(sort(x1,3),sort(x2,3),done) then fail
  566.        "set"   : if not Equiv(sort(x1),sort(x2),done) then fail
  567.        default : fail            # Vaues of other types are different. 
  568.    }
  569.  
  570.    insert(done[x1],x2)            # Equivalent; add to set.
  571.    return x2
  572.  
  573. end
  574.  
  575. --------------------------------  cut here --------------------------------
  576. -- 
  577.  
  578.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  579.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  580.